#!/usr/bin/env perl
#
# Copyright (c) 2008 Xiangmin Jiao, Stony Brook University.
#
# Based on matwrap, Copyright (c) 1997 Gary R. Holt.
# This software is distributed under the terms of the
# perl artistic license (http://language.perl.com/misc/Artistic.html).
#

require 5.006;

# Determine include path
$dir = $0;
$dir =~ s/(.+\/)?(\w+)$/$1/;
$incdir = "${dir}share";
push @INC, $incdir;

require "codegen_cmex.pl";

$progname = 'c2mex';

@files = ();    # No files to parse.
$debug = 0;     # Not in debug mode.
$mergefiles = 1;

$default_retlast = 1;    # Whether to put return value to last

$default_strlen = 0;     # Default length of char* type

$default_strfree = "";   # Default function for freeing char** type

$default_url = "";       # Default URL for online documentation

$default_retname = "ret";    # Default name for return value

@strings    = ();            # Where we store quoted strings, etc.
@brace_strs = ();            # Where we store strings surrounded by braces
                             # which we removed.

@function_names = ();        # Names of functions 

%functions = ();             # The prototype, etc., of each global
                             # function, indexed by function name.  Elements
                             # are associative arrays (see the .pod file
                             # for more details).

@basic_type_keywords = (
    qw(short long signed unsigned
      float double int char const ptrdiff_t)
);
@basic_types{@basic_type_keywords} = @basic_type_keywords;

%typedef =                   # Contains definitions of types.
  (
    %basic_types,            # Fill out the types with the known types.
                             # Unknown words in the type field will be
                             # assumed to be argument names (for function
                             # arguments) and will be ignored.  We also
                             # ignore some keywords like 'inline' and
                             # 'virtual' and 'extern'.
    'void'   => 'void',      # Other type words relevant for functions:
    'static' => 'static',
    'const'  => 'const',     # Keep 'const' around.
    'inline' => ''           # Delete occurrences of 'inline'.
  );

%enummap = ();               # Values of enumeration type.

@typekeys = ();

@builtin_matlab_types = (
    qw(double single char int8 uint8 int16 uint16 int32 uint32 int64 uint64)
);

@builtin_typemap{@builtin_matlab_types} = @builtin_matlab_types;

%typemap = (%builtin_typemap);

###############################################################################

$outdir =  cmex::parse_argv( \@ARGV );

while ( $_ = shift(@ARGV) ) {       # Get the next argument:
    if (/^-debug$/) {               # Dump out definitions?
        $debug = 1;
    }

    #
    # Unrecognized switch:
    #
    elsif (/^-$/) {                 # Is it an option?
        die("$progname: illegal option $_\n");
    }
    else {                          # Not an option, must be a file name.
        push( @files, $_ );
    }
}

$outfilebase = "";

$include_str = "";
if (@files) {                    # Any files explicitly named?
    local ($/) = undef;          # Slurp in files all at once.
                                 # This makes parsing much simpler.

    foreach $file (@files) {     # Parse our list of files.
        if ( $file =~ /\.[hH]{1,2}$/ ) {
            $include_str .=
              "#include \"$file\"\n";    # We'll probably need to include
                                         # this file in the generated code.

            if ( length( $outfilebase) == 0) {
                $outfilebase = $file;
                $outfilebase =~ s/^(.+\/)?(\w+)\.[hH]{1,2}$/$2/;
            }
        }
        else {
            warn("$progname: $file is not an include file\n");
        }

        open( INFILE, $file ) || die("$progname: can't open $file--$!\n");
        $_ = <INFILE>;                   # Read the whole file.
        close(INFILE);                   # Done with the file.

        eval { &parse_str($_); };        # Parse this string.
        $@ and warn("In file $file:\n$@");
    }
}

if ($debug) {

    #
    # DEBUG: dump out the definitions.
    #
    print "Typedefs:\n";
    foreach ( sort keys %typedef ) {
        print "  $_ => $typedef{$_}\n";
    }

    print "\nFunctions:\n";
    foreach ( @function_names ) {
        dump_function( "  ", $functions{$_} );
    }
}

if ($mergefiles) {
    write_files_merged();
}
else {
    write_files_separate();
}

#
# Write out separate output files:
#
sub write_files_separate {

    foreach ( @function_names ) {        # Now wrap all the global functions.
        my $faa = $functions{$_};

        next if ( $faa->{external});

        if ( length($outfile) == 0 ) {
            if ( @{ faa->{inouts} } > 0
                 || faa->{withcast} ) {
                $fname = "$outdir/$_" . "_mex.c";
            }
            else {
                $fname = "$outdir/$_.c";
            }
        }
        else {
            $fname = $outfile;
        }

        print STDOUT "Generating files $fname and $outdir/$_.m.\n";

        cmex::initialize( $fname, \@files, \@ARGV, $include_str );

        cmex::wrap_function( $faa);

        cmex::print_matlab_code( $faa, 0);

        cmex::finish();       # We're done!
    }
}

#
# Now write out single C file:
#
sub write_files_merged {

    $fname = "$outdir/${outfilebase}_mex.c";

    print STDOUT "Generating files $fname.\n";

    cmex::initialize( $fname, \@files, \@ARGV, $include_str );

    my $ccode = "";
    my $func_id = 0;
    my $withextern = 0;

    foreach ( @function_names ) {        # Now wrap all the global functions.
        my $faa = $functions{$_};
        ++$func_id;

        # print STDOUT "Processing function $_ and generating M-file $outdir/$_.m.\n";
        $ccode .= cmex::wrap_function( $faa);

        $withextern ||= $faa->{external};
        cmex::print_matlab_code($faa, $func_id);
    }

    if ( $withextern) {
        $ccode .= "#include \"${outfilebase}_mex_ext.c\"\n\n";
    }

    $ccode .= cmex::switch_gateway( \@function_names);

    cmex::finish($ccode);       # We're done!
}

# Return a string of programming language
sub language {
   "C";
}

#
# Convert string into integer
#
sub atoi {
    my $t = 0;
    foreach my $d ( split( //, shift() ) ) {
        $t = $t * 10 + $d;
    }
    return $t;
}

#
# Get C-prototype of given Fortran subroutine
#
sub get_prototype {
     local ($faa) = @_;    # Access the argument.
     
     my @funcargs = map{
        my $arg = $faa->{args}{$_};    # Access this argument.
         
        { $arg->{type} . " " . $_}
    } @{ $faa->{argnames} };
    
     my $prototype = "$faa->{returns} $faa->{name}( "
          . join( ", ", @funcargs ) . ");";
}


#
# Handle all the definitions contained in a string.  Arguments:
# 1) The string.
#
# Side effects: adds entries to the following arrays:
#   $functions{name}            Points to an array containing (as element 0)
#                               the return type of the function, and
#                               (as elements 1-n) type types of its arguments.
#
sub parse_str {
    local ($_) = @_;    # Access the argument.

 # Replace all things that could confuse a simple-minded parser by a tag.
 # We want to make sure that our brace and parenthesis matching is accurate,
 # so we remove all comments and quoted strings.  This is a little tricky
 # to do accurately because there could be quotes inside of comments or
 # (partial) comments inside of quoted strings.  We also should handle \" and
 # \' properly.  The algorithm for doing this is:
 # 1) Remove all backslash escapes.
 # 2) Remove all comments and quoted strings at once using an ugly and
 #    slow regular expression (which seems to work).
 # Comments and quoted strings are removed and are replaced by a tag value which
 # is just some binary characters surrounding a number.  The number is the
 # index into the array where we stored the string.
 #
    # Substitute CGNS_ENUM?(var) by var
    s@CGNS_ENUMF\s*\(\s*(\w+)\s*\)@cg_$1@g;
    s@CGNS_ENUM[VTD]\s*\(\s*(\w+)\s*\)@CG_$1@g;

    # Remove CGNSDLL
    s@CGNSDLL@@g;

    # Protect :// in url in /*%...*/
    s@/\*(%\s*url \w+)(://)(.*)\*/@\n$1:%%$3@g;
    s@/\*(%\s*default_url \w+)(://)(.*)\*/@\n$1:%%$3@g;

    # Protect :// in url in //%...
    # Convert //% url ... into %url .
    s@//(%\s*url \w+)(://)(.*)/@\n$1:%%$3@g;
    s@//(%\s*default_url \w+)(://)(.*)/@\n$1:%%$3@g;

    s@/\*(%.+)\*/@\n$1@g;   # Convert /*\ ... */ into /* %input */.  This allows
                            # declarations to be put into C files.
    s@//(%\s*\w+)@\n$1@g;   # Convert //%input into %input.  This allows
                            # declarations to be put into C files.
    s{\\[\0-\377]}{push(@strings, $&); # First remove all backslash escapes.
		   "\01$#strings\02"; }eg;    # Leave a tag.

    s/\bextern\s*\"[^\"]*\"\s*\{?//g;
                            # Remove all the "extern "C"" declarations.


    s{/\* [\0-\377]*? \*/ |       # C-style comment.
      //.* (?:\n[ \t]*//.*)* |    # Several lines of new style comments.
      \" .*? \" |                 # Double quoted string.
      \' .*? \'                   # Single quoted string.
     }{
      if (substr($&, 0, 1) eq '/') {  # Was this a comment?
      #       push(@comments, $&);    # Save it.
      #       "\03$#comments\04";     # Leave the tag.
      "";           # Strip out the comments.
      } else {                  # No, it must have been a string.
          push(@strings, $&);   # Save it in a different place.
          "\01$#strings\02";    # Leave a different tag.
      }
  }xeg;
  
    #
    # Now parse the typedefs in the file. We look for enum, typeder, etc.
    #
    parse_for_typedefs($_);

    # Remove strings start with %enumdef and %typemap
    s/%enumdef\s+(.+)\s*\n//eg;
    s/%typemap\s+(.+)\s*\n//eg;

    #
    # Now pull out all expressions in braces.  This has to be done in several
    # scans so we handle nested braces.  Because we have protected comments
    # and quoted strings, there shouldn't be any problem with braces inside
    # quotes.
    #
    s/\bextern\s+\01\d+\02\s*\{?//g; # Remove all the "extern "C"" declarations.
                                     # Note that this may leave an extra brace.
                                     # We don't care.
    1 while s{\{[^\{\}]*\}}{	     # Now remove expressions in braces.
	push(@brace_strs, $&);	         # Save the expression.n
	"\05$#brace_strs\06";            # Replace it by a tag.
    }eg;    # This has to be done in a loop because we
            # remove the innermost braces first, followed
            # by the next, etc.

    s{\b(?:struct|typedef\s+struct\s+\05\d+\06)\s+(\w+)\s*;}{
	$typedef{$1} or		    # Do we already know of this type?
	    $typedef{$1} = $1;	# Remember that we know this type.
	"";			            # Delete the definition.
    }eg;    # Strip out forward struct definitions.

    # Check whether default_strlen is specified
    s{%default_strlen\s+(\w+)\s*\n}{
        $default_strlen = atoi($1);  # Set default strlen.
        $default_strlen > 1 or $default_strlen = 1; 
        "";                    # String.
    }eg;

    s{%default_strfree\s+(\w+)\s*\n}{
        $default_strfree = $1;  # Set default strlen.
        "";                    # String.
    }eg;

    s{%default_retlast\s+(\w+)\s*\n}{
        $default_retlast = atoi($1);  # Set default strlen.
        "";                    # Empty string
    }eg;

    s{%default_retname\s+(\w+)\s*\n}{
        $default_retname = $1;  # Set default strlen.
        "";                     # Empty string.
    }eg;

    # Check whether default_url is specified
    s{default_url\s+(.+)\s*\n}{
        $default_url = $1;     # Set url.
        $default_url =~ s/(w+:)%%/$1\/\//g;
        "";                    # String.
    }eg;

    #
    # Look for function declarations:
    #
    1 while s{
	    (?:^|\G|[;\}\06])           # Match beginning of statement (end of last).
	    \s*                         # Whitespace between statements.
	    (\w[\w<>\s\*\&]*?)?         # The return type of the function.
	    (\w+)\s*                    # The name of the function.
	    \(([:<>\w\s\*\&\.,]*)\)\s*  # The function arguments.
	    (?:; |                      # The trailing semicolon, for a prototype.
	    \05\d+\06)\s*               # The body of the function.
	    ((?:\s*%.*\n)+)?            # Any additional modifiers.
	}{
	    my ($fdef, $fname);
            eval {
                ($fdef, $fname) = parse_function($1, $2, $3, split(/\n\s*/, $4 || ""));
                # Parse the function definition.
            };
            if ($@) {	# Was there an error?
                print STDERR "$progname: error parsing definition of $1 $2:\n$@\n";
            } else {
                defined($fdef) and $functions{$fname} = $fdef and push(@function_names, $fname);
                # If it wasn't a static function, remember it.
            }
            
	    '';			# Just remove the whole statement.
	}xeg;


    if (/\w/) {    # Some non-punctuation that we didn't recognize?
        s/(?:[ \t]*\n)+/\n/g;     # Collapse multiple newlines into 1.
        s/\05\d+\06/{ ... }/g;    # Put braces back in understandable form.
        1 while s/\01(\d+)\02/$strings[$1]/g;    # Put quoted strings back too.
             # die "Warning: unrecognized text:\n$_\n";
    }
}

#
# Parse a function prototype.  Arguments:
# 1) The return type of the function.
# 2) The name of the function.
# 3) The argument list for the function (not including the THIS argument for
#    member functions).
# 4-n) Additional declarations (%input, etc.), if any.
#
# Returns a reference to the %function_def array appropriate to this function.
# Returns undef if it was a static function.
#
# Also returns the name of the function, which will be different from the name
# passed if there was a %rename directive.
#
sub parse_function {
    my ( $ftype, $fname, $arglist, @addl_decls ) = @_; # Access the arguments.

    $ftype = canonicalize_type($ftype);    # Get the type of the function.
    my $static_flag = ( $ftype =~ s/\bstatic\s*// );   # Is the function static?
          # (This also removes "static" from the type.)
    $static_flag and return undef;

    #
    # Look at the additional declarations and convert things like
    #    %input x(a,b), y(a,b)
    # into two separate declarations:
    #    %input x(a,b)
    #    %input y(a,b)
    #
    @paren_expr = ();    # No parenthesized subexpressions known yet.
                         # Note that this is a global variable, because
                         # it's used in parse_dimension_decl.
    my @decl_copy;
    foreach (@addl_decls) {
        if (/^\s*%\s*ignore\s*$/) {    # Don't wrap this function?
            return undef;              # Quit now.
        }
     
        1 while s{(\([^()]*\))}{    
                                      # Save parenthesized sub-expressions
        push(@paren_expr, $1);
        "\01$#paren_expr\02"; }eg;    # Replace it with a tag.

        # Convert "%input x(a), y" into two
        # separate declarations, "%input x(a)" and
        # "%input y".
        push( @decl_copy, "%$1 $2" )
          while (
s/^\s*\%\s*(input|inout|output|typecast)\s+(\w+(?:\s*\01\d+\02)?)\s*,\s*(.*)/%$1 $3/
          );
        push( @decl_copy, $_ );     # Save what's left.
    }

    # If the function has optional arguments, then ignore the function
#    if ( $arglist =~ /.*\.\.\..*/ ) {
#        print STDERR "Warning: vararg is not supported. "
#          . "Function $fname($arglist) will be ignored.\n";
#        return undef;
#    }

    # Set free_func, which will be overwritten if %strfree is used.
    $free_func = $default_strfree;
    $retlast   = $default_retlast;
    $retname   = $default_retname;

    # Don't try to make an entry for static
    # functions since we can't access them anyway.
    #
    # Process the argument list.  First, we pretty up the list of printable
    # arguments, and then we convert that to our internal types.
    #
    $arglist =~ s/^\s*void\s*$//;    # Change argument of "void" to "".
    if ( $arglist =~ /[\(\)]/ ) {    # Does it have stuff we don't understand?
        warn(
            "$progname: function pointers and other complex types not accepted
  in definition of function $fname, arglist $arglist\n"
        );
        return undef;                # Skip this function.
    }

    #
    # Access argument list
    #
    my @args = split( /,/, $arglist );    # Access the argument list.

    $ftype ne 'void' and    # Pretend the return value is the first
      unshift( @args, "$ftype __r_e_t__" )
      ;                     # argument for the moment.  We'll take
                            # it off later.

    my @canon_args = map { canonicalize_type($_) } @args;

    # Get the canonical types.
    #
    # Try to infer as much of the rest of the definition as possible.  We can
    # infer everything if there are no pointer or reference types.
    #
    # First give names to all arguments that don't have any:
    #
    my $script_name;        # The name of the function in the scripting
                            # language, if different.
    my @argnames = map {    # Get names for each argument to C function.
        (
            (
                $args[$_] =~ /(\w+)\s*(?:=|$)/ &&    # Take last word in type as
                  !exists( $typedef{$1} )
            )
            ?    # arg name if it's not a type.
              $1
            :       # Use the name if it was there.
              $1    # "_$_"
        );          # Generate a name for the argument.
    } 0 .. ( @args - 1 );    # Get the specified names for each argument.

    my %args;                # This array will become the "args" field of
                             # the %function_def array.

    my $withcast = 0;

    #
    # Process the argument declarations:
    #
    my $argidx;
    foreach $argidx ( 0 .. ( @argnames - 1 ) ) {
        my $argname = $argnames[$argidx];      # Access the argument name.
        my $argtype = $canon_args[$argidx];    # Access its type.

        my $decl =
          ( $args{$argname} = {} );    # Create a declaration for this arg.

        if ( $argidx == 0 && $argname eq '__r_e_t__' ) {
            $decl->{c_var_name} = "_";
        }
        else {
            $decl->{c_var_name} = "_$argname";    # Append prefix
        }

        $decl->{type} = $argtype;
        if ( $argtype =~ /[^\w]?(enum) (\w+).*/ ) {
            $decl->{type} =~ s/(enum) (\w+)/$2/g;
            $argtype      =~ s/(enum \w+)/int/g;
        }

        $argtype =~
          s/\bconst\b\s*//g;    # Strip out const to avoid multiplicities of
                                # types.

     #
     # If there's an extra '*' on the end of a type we recognize, we assume that
     # we pass it by reference and put a & in front of the variable.
     #
        if ( $argtype =~ /^(.*?)\s*\*$/ && is_basic_type($1) ) {
            $argtype = $1;      # Strip off the trailing *.
            if ( $argtype eq "char *" ) {
                $argtype = "char";
                $decl->{source} = "output";
            }
            else {
                if ( $decl->{type} =~ /^(.*?)\s*const\s+.*\*$/ ) {
                    $decl->{source} = "input";    #Jim: Mark it as input
                }
                else {
                    $decl->{source} = "inout";    #Jim: Mark it as inout
                }
            }
            $decl->{dimension} = ["(:)"];         #Jim: Mark it one-dimensional
            $decl->{pass_by_pointer_reference} = 1;

            # Remember to put & in front of call.
        }
        else {
            $decl->{pass_by_pointer_reference} =
              0;    # Don't put & in front of call.
            if ( $decl->{type} eq "void *" ) {
                $withcast = 1;
                $decl->{source} = "inout";    #Jim: Mark it as inout
            }
            elsif ( $argtype eq "void *" ) {
                $withcast = 1;    #must be const void * or void const *
            }
        }

        # Save modified type name.
        $decl->{basic_type} = $argtype;
    }

    $ftype ne 'void'
      and $args{'__r_e_t__'}{source} =
      'output';                   # "__r_e_t__" is always an output var.

    my $see      = "";
    my $url      = "";
    my $castvoid = "";
    my $external = 0;

    #
    # Now parse all of the % declarations:
    #
    #TODO: Add directives to allow specification of minimum and maximum sizes.
    #Check the sizes in C code and use maximum size for memory allocation in M-code.
    foreach (@decl_copy) {
        if (/^\s*%\s*(input|inout|output)\s+(\w+)(?:\s*\01(\d+)\02)?\s*$/)
        {                         # Input argument?
            my $arg = $args{$2};    # Point to the argument description.
            defined($arg)
              || die("In definition of $fname:\n  Illegal argument name $2\n");

            if (   $1 eq "output"
                && ( defined($3) || $arg->{basic_type} eq "void *" )
                && $arg->{source} ne "input" )
            {
                $arg->{source} = "inout";
            }
            elsif ($arg->{type} ne "char **" && $arg->{type} ne "void *"
                || $1 eq "input" )
            {
                $arg->{source} = $1;    # Remember the variable type.
                unless ( defined($3) || $arg->{source} == "inout" ) {
                    $arg->{dimension} = [];
                }
            }

            if ( defined($3) ) {        # Is this a vector?
                $arg->{dimension} =
                  parse_dimension_decl( $paren_expr[$3], \%args );
                $arg->{rawdimension} = $paren_expr[$3];
                $arg->{rawdimension} =~ s/\((.+)\)/$1/g;
                $arg->{rawdimension} =~ s/\01(\d+)\02/$paren_expr[$1]/g;
                $arg->{rawdimension} =~ s/\s//g;
                
                $arg->{basic_type} =~ s/\s*\*$//

                  # If this was declared as a pointer, change
                  # the basic type by taking off a '*'.  Thus
                  # char * goes into char, and float ** goes
                  # into float.
                  unless $arg->{pass_by_pointer_reference};

                # If we already marked it to pass by reference,
                # then we already took off the '*'.
            }
            elsif (
                $2 ne '__r_e_t__' &&    # Can't alter the type of __r_e_t__.
                $1 eq 'output'
                && substr( $args{$2}{basic_type}, -1 ) eq '*'
                && $arg->{basic_type} ne "void *"
                &&    # Is this an output variable and it's being
                      # passed as a pointer?
                !$arg->{pass_pointer_by_reference}
              )
            {

                # We didn't already strip off the '*'?
                $arg->{pass_by_pointer_reference} = 1;    # Pass a reference.
                $arg->{basic_type} =~ s/\s*\*//;          # Strip off the *.
            }
            elsif ( $arg->{source} ne "inout" && $arg->{type} ne "char **" ) {
                $arg->{dimension} = [];
            }
        }
        elsif (/^\s*%\s*typecast\s+(\w+):\s*(\S+)\s*$/) {
            my $arg = $args{$1};    # Point to the argument description.
            defined($arg)
              || die("In definition of $fname:\n  Illegal argument name $1\n");

            ( substr( $arg->{type}, -1 ) eq '*' )
              || die(
"In definition of $fname:\n  Cannot cast non-pointer argument $1\n"
              );

            $arg->{cast} = $2;
            $arg->{cast} =~ s/\s//g;

            $arg->{rawcast} = $2;
            $arg->{rawcast} =~ s/\01(\d+)\02/$paren_expr[$1]/g;
            $arg->{rawcast} =~ s/\s//g;
            
        }
        elsif (/^\s*%\s*rename\s+(\w+)\s*$/)
        {    # Name of function in scripting language?
            $script_name = $1;    # Remember that.
            $fname       = $1;    # Remember the new name.
        }
        elsif (/^\s*%\s*seealso\s+(.+)\s*$/) {    # Other references
            $seealso = $1;                        # Remember it.
        }
        elsif (/^\s*%\s*url\s+(.+)\s*$/) {        # URL for online documentation
            $url = $1;                            # Remember it.
            $url =~ s/(\w+:)%%(\S*)\s+$/$1\/\/$2/g;
        }
        elsif (/^\s*%\s*external\s*$/) {        # External function
            $external = 1;                      # Remember it.
        }
        elsif (/^\s*%\s*strfree\s+(\w+)\s*$/)
        {    # Name of function to call to free character strings?
            $free_func = $1;    # Remember that.
        }
        elsif (/^\s*%\s*retlast\s+(\w+)\s*$/)
        {    # Name of function to call to free character strings?
            $retlast = atoi($1);
        }
        elsif (/^\s*%\s*retname\s+(\w+)\s*$/)
        {    # Name of function to call to free character strings?
            $retname = $1;
        }
        else {
            1 while s/\01(\d+)\02/$paren_expr[$1]/;  # Put all the parenthesized
                 # sub-expressions back to print it out properly.
            die(
"In definition of function $fname: unrecognized declaration $_\n"
            );
        }
    }

    #
    # Now for each of the input variables whose dimension is given by
    # a C expression, see if we can find a way to compute the variable in the
    # expression.  If so, we can eliminate the dimension variable from the
    # argument list.
    #
    foreach $argname (@argnames) {
        my $arg = $args{$argname};    # Get this argument.
        $arg->{source} ||= 'input'; # Make all unspecified arguments input args.

        # Append prefix in, out, and io.
        if ( $arg->{source} eq 'input' || $arg->{source} eq 'dimension' ) {
            $arg->{c_var_name} = "in" . $arg->{c_var_name};
        }
        elsif ( $arg->{source} eq 'output' ) {
            if ( $arg->{c_var_name} eq '_' ) {
                $arg->{c_var_name} = $retname;
            }
            else {
                $arg->{c_var_name} = "out" . $arg->{c_var_name};
            }
        }
        else {
            $arg->{c_var_name} = "io" . $arg->{c_var_name};
        }

#        if ( $arg->{type} =~ /.+\*\*/ && $arg->{type} ne "char **" ) {
#            print STDERR
#              "Warning: Array of pointers '$arg->{type}' is not supported. "
#              . "Function $fname($arglist) will be ignored.\n";
#            return undef;
#        }

        $arg->{dimension} ||= [];    # Default to a dimensionless variable.

        next unless @{ $arg->{dimension} };    # Skip if not an array argument.
        $arg->{pass_by_pointer_reference} = 0; # If it's an array argument, we
                                               # want this to be 0.

        next
          unless (
            $arg->{source} eq 'input' ||       # Skip if not an argument whose
            $arg->{source} eq 'inout'          # value is given.
          );

        my $dimidx = 0;
        foreach ( @{ $arg->{dimension} } )
        {    # Look at the expression for each dimension.

      #
      # See if we can invert this expression to determine the value of a
      # dimensional variable.  If so, then we can remove the argument from the
      # argument list.
      #
      # We can only invert simple arithmetic expressions, i.e., things in which
      # only one argument is present, and which are of the form
      #       arg
      #       arg+1
      #       arg-1
      #       2*arg
      #       2*arg-1
      # Expressions may not be substituted for the '1' and '2', though any other
      # integer may be.
      #
      # Other forms we can't handle, so we require that the value be specified.
      #
            if (/^_arg_(\w+)$/) {    # Just the argument word by itself?
                $args{$1}{calculate} = "dim($argname, $dimidx)";
                $args{$1}{source}    =
                  'dimension';       # Mark as a dimensional variable.
            }
            elsif (/^_arg_(\w+)\s*([\-\+])\s*(\d+)$/) {    # First or second form?
                $args{$1}{calculate} ||=
                  "dim($argname, $dimidx)" . ( $2 eq '-' ? '+' : '-' ) . $3;
                $args{$1}{source} =
                  'dimension';    # Mark as a dimensional variable.
            }
            elsif (/^(\d+)\s*\*\s*_arg_(\w+)$/) {    # Simple multiplication?
                $args{$2}{calculate} ||= "dim($argname, $dimidx)/$1";
                $args{$2}{source} =
                  'dimension';    # Mark as a dimensional variable.
            }
            elsif (/^(\d+)\s*\*\s*_arg_(\w+)\s*([\-\+])\s*\d+$/) {
                $args{$2}{calculate} ||=
                    "(dim($argname, $dimidx)"
                  . ( $3 eq '-' ? '+' : '-' )
                  . "$4)/$1";
                $args{$2}{source} =
                  'dimension';    # Mark as a dimensional variable.
            }
            $dimidx++;
        }
    }

    #
    # Now form the list of input/output/inout arguments in order, removing
    # dimensional arguments:
    #
    my ( @inputs, @inouts, @outputs );    # Array of argument names that will be
                                          # the input/inout/output variables.

    foreach $argname (@argnames) {
        next
          if exists( $args{$argname}{calculate} ); # Do we know how to calculate
            # this variable from the others?
        if ( $args{$argname}{source} =~ /^input|dimension$/ ) {

            # It will be 'dimension' if this is an argument
            # that specifies another argument's dimension
            # but we couldn't actually calculate the
            # argument because the expression wasn't
            # invertible, e.g., %input a((b > 0) ? b : -b)
            # defines b as a dimensional variable but
            # b cannot be calculated so it must be
            # explicitly specified.
            push( @inputs, $argname );
        }
        elsif ( $args{$argname}{source} eq 'inout' ) {
            push( @inouts, $argname );
        }
        elsif ( $args{$argname}{source} eq 'output' ) {
            push( @outputs, $argname );
        }
        else {
            die(
"internal error, invalid argument source '$args{$argname}{source}'"
            );
        }
    }

    #
    # Re-name cast variables
    #
    foreach (@argnames) {
        next unless ( defined( $args{$_}{cast} ) );
        my $cast  = $args{$_}{cast};
        my $casto = $args{$cast};

        # First check whether it is being casted into a character string
        if ( $cast =~ /(\w+)\01(.*)\02$/ ) {
            my $funcname = $1;
            my $arglis = $paren_expr[$2];
            $arglis =~ s/\((.*)\)/$1/g;
            # It is a function call. Change all occurrences of variable names
            my @vars   = split( /,/, $arglis);    # Obtain list of variables.

            my $argcount = 0;
            foreach my $var (@vars) {
                my $casto = $args{$var};

                if ( !defined($casto) || $casto->{source} eq 'output' ) {
                    die(
'Arguments to type cast must be input/inout arguments of current function.'
                    );
                }

                $vars[$argcount++] = $casto->{c_var_name};
            }
            $args{$_}{cast} = $funcname . "(" . join(", ", @vars) . ")";
        } 
        elsif ( $cast =~ /\w+/ ) {
            if ( !defined( $typemap{$cast} ) ) {
                if ( !defined($casto) || $casto->{source} eq 'output' ) {
                    die(
'Cast basis must be pre-defined type-key, built-in type, or input/inout argument.'
                    );
                }
                $args{$_}{cast} = $casto->{c_var_name};
            }
        }
        else {
            die("Unrecognized typecast string $cast.");
        }
    }

    if ( $ftype ne 'void' ) {    # Was there a return type?
        if ($retlast) {

            # Move return value to the end of output list
            push( @outputs, $argnames[0] );
            shift(@outputs);
        }
        shift(@argnames);        # Remove the return value from the argument
        shift(@canon_args);      # list since it is handled separately.
    }

    #
    # Now we've generated all the pieces for the %function_def array.  Fill in
    # all of the fields:
    #
    (
        {
            name        => $fname,
            script_name => $script_name,
            free_func   => $free_func,
            static      => $static_flag,
            inputs      => \@inputs,
            inouts      => \@inouts,
            outputs     => \@outputs,
            returns     => $ftype,
            args        => \%args,
            argnames    => \@argnames,
            seealso     => $seealso,
            url         => $url,
            withcast    => $withcast,
            external    => $external
        },
        $fname
    );

}

#
# The following subroutine parses a dimension declaration, e.g.,
#   %output varname(dim1, dim2)
# Arguments:
# 1) The dimension string (including parentheses).
# 2) A reference to an associative array where we store the names of dimension
#    variables.
#
# Returns: a reference to a list which will become the "dimension" field
# of the "args" subfield of the %function_def array, i.e.,
#    [dim1, dim2]
# where dim1 and dim2 are expressions which are the dimensional values.
# These expressions may contain the parameter names or other C expressions.
# The parameter names are substituted to their C equivalents.
#
# Global variable inputs: @paren_expr contains all parenthesized expressions
# that were removed to facilitate parsing.
#
sub parse_dimension_decl {
    my ( $dimstr, $args ) = @_;    # Name the arguments.

    $dimstr =~ s/^\((.*)\)$/$1/;   # Strip the parentheses.

    my @dims = split( /,/, $dimstr || "" );    # Split into components.

    foreach (@dims) {
        1 while s/\01(\d+)\02/$paren_expr[$1]/;    # Replace parenthesized
             # expressions; now commas in parentheses can't
             # hurt us since we've already done the split.
        s/^\s+//;    # Remove leading whitespace.
        s/\s+$//;    # Remove trailing whitespace.

        #
        # Find any parameter names in this dimension declaration.
        #
        my @expr_tokens =
          split( /(\W+)/, $_ );    # Split it on non-words (operators),
                                   # but put the operators into the array.
        my $idx;
        my $n_params = 0;    # The number of parameters that were contained
                             # in this expression.
        for ( $idx = 0 ; $idx < @expr_tokens ; ++$idx ) {  # Look at each token:
            my $arg =
              $args->{ $expr_tokens[$idx] };    # See if this word is in the
                                                # argument list.
            next unless defined($arg);  # Skip if it's an operator or some other
                                        # word.
            $arg->{source} =
              'dimension';              # Remember this is a dimension variable.
            $expr_tokens[$idx] = "in" . $arg->{c_var_name};

            # Replace it in the expression so that we
            # know how to do the dimension checking.
        }
        if ( @expr_tokens == 1 ) {      # Only one thing?
            $_ = $expr_tokens[0];       # Put it back (in case we changed it).
        }
        else {
            $_ = '(' . join( '', @expr_tokens ) . ')';   # Put the expression in
                                                         # parentheses.
        }
    }
    return \@dims;
}

#
# The following function is called to convert a type into a canonical format.
# It handles typedefs and puts the '*' and '&' in the appropriate locations.
# Arguments:
# 1) The type name to canonicalize.
# 2) True if unrecognized words should be understood as builtin types that we
#    don't understand.
#
sub canonicalize_type {
    my ( $type, $new_type_flag ) = @_;    # Access the argument.

    my $oldval = $type;
    $type =~ s/=.*//;    # A default value can be specified, and we
                         # should ignore it.
    if ($new_type_flag) {    # Add unrecognized words to the basic type list?
        $type =~ s{\w+}{$typedef{$&} ||= $&}eg;
    }
    else {
        $type =~
          s{\w+}{$typedef{$&} || ''}eg;    # Translate the typedefs, and delete
            # any words that we don't care about, like
            # 'inline', or function arguments names.
    }

    $type =~ s/\[\]/\*/;          # Convert float[] into float *.
    $type =~ s/\s+/ /g;           # Convert whitespace into spaces.
    $type =~ s/^ //;              # Strip leading whitespace.
    $type =~ s/ $//;              # Strip trailing whitespace.
    $type =~ s/ ([\*\&])/$1/g;    # Remove spaces between '*' and '&'.
    $type =~ s/[\*\&]/ $&/;       # Put a space before the first one.
    if ( $type eq '' ) {
        $oldval =~ s/\s+/ /g;     # Pretty-print the type.
        die("unrecognized type '$oldval'\n");
    }

    #  print STDERR "Canonicalizing $oldval => $type\n";
    $type;
}

# Dump out the definition of a function (for debug purposes).  Arguments:
# 1) A string used to prefix each line so the indentation looks right.
# 2) The %function_def array.
#
sub dump_function {
    my ( $indent_str, $faa ) = @_;    # Name the arguments.

    printf(
        "%s%s%s %s(%s)\n",
        $indent_str,
        $faa->{static} ? "static " : "",
        $faa->{returns},
        $faa->{name},
        join( ", ",
            map( { $faa->{args}{$_}{type} . " " . $_ } @{ $faa->{argnames} } ) )
    );

    # Print out the Matlab function prototype.
    printf(
        "%s  [%s] = %s(%s)\n",
        $indent_str,
        join( ", ", @{ $faa->{outputs} }, @{ $faa->{inouts} } ),
        $faa->{script_name} || $faa->{name},
        join( ", ", @{ $faa->{inputs} }, @{ $faa->{inouts} } )
    );

    foreach ( @{ $faa->{outputs} }, @{ $faa->{inouts} }, @{ $faa->{inputs} } ) {
        printf(
            "%s  %s %s: basic type = %s, dimension = [%s]\n",
            $indent_str, $faa->{args}{$_}{source},
            $_,
            $faa->{args}{$_}{basic_type},
            join( ", ", @{ $faa->{args}{$_}{dimension} } )
        );
        if ( exists( $faa->{args}{$_}{calculate} ) ) {   # A dimension argument?
            printf( "%s    Calculate from %s\n",
                $indent_str, $faa->{args}{$_}{calculate} );
        }
    }
}

#
# Return true if the type is a basic type that can be freely and easily
# copied.
#
sub is_basic_type {
    my ($typename) = @_;                                 # Access the argument.

    if ( $typename =~ /\*$/ ) {                          # Is it a pointer type?
        return 1;    # Pointers can be freely copied.
    }

    foreach ( split( ' ', $typename ) ) {    # Look at all the words:
        return 0
          unless exists( $basic_types{$_} );    # Skip if not a basic type word.
    }
    return 1;                                   # It's a basic type.
}


###############################################################################
#
# Code to parse the input files:
#

#
# Parses enum type.  Arguments:
# 1) The string.
#
# Side effects:
#   It adds the enum type into typedef and create M-files for the type and the constants.
#
sub parse_enum {
    my ( $typename, $vars ) = @_;    # Access the argument.
    $vars =~ s/\s//g;
    my @vars = split( /,/, $vars );    # Obtain list of variables.

    my $anonymous = ( $typename eq "" );
    unless ($anonymous) {
        print STDOUT "Generating M-files for enum type $typename.\n";
    }

    #
    # We also generate an auxiliary .m file which contains the help text.
    #
    local (*MFILE);                    # Make a local file handle.
    unless ($anonymous) {
        open( MFILE, "> $outdir/$typename.m" ) ||    # Create the file.
          die("can't open file $outdir/$typename.m--$!\n");
        print MFILE "%% Enumeration type $typename with values:\n%%\n";
    }

    my $count = 0;
    my $key; 
    my $val;
    foreach (@vars) {
        next unless ( $_ ne "" );
        if (/(\w+)=([\+\-\d]+)/) {
            $key = $1;
            $val = $2;
        }
        elsif (/(\w+)=(\w+)/) {
            $key = $1;
            if ( defined( $enummap{$2} )) {
                $val = $enummap{$2};
            }
            else {
                $val = $2;
            }
        }
        else {
            $key = $_;
            $val = $count;
        }
        unless ($anonymous) { printf( MFILE "%% %32s: %16s\n", $key, $val ); }
        $enummap{$key} = $val;

        # print STDOUT "Generating M-files for enum value $key.\n";

        local (*MFILE_2);
        if ( open( MFILE_2, "> $outdir/$key.m" ) ) {
            print MFILE_2 "function val = $key\n"
              . "%% Value $val of enumeration type $typename\n"
              . "val = int32($val);\n";
            close(MFILE_2);    # Done with this file.
        }
        $count++;
    }

    unless ($anonymous) {
        close(MFILE);
    }    # Done with that file.
}

###############################################################################
#
# Code to parse the input files:
#

#
# Just extract the typedefs from a string.  Arguments:
# 1) The string.
#
# Side effects:
#   New types may be added to the %typedefs array.
#
# Function and variable definitions are ignored.
#
sub parse_for_typedefs {
    local ($_) = @_;    # Access the argument.

    s{\\[\0-\377]}{}g;  # Delete all backslash escapes.

    # Remove all expressions within struct.
    1 while s{\Wstruct\s+(\w+)\{[^\{\}]*\}}{
         $typedef{$1} ||= "struct $1";
         "";
    }g;

    # Check whether enumdef is defined
    my $enumdef = "";
    s{%enumdef\s+(.+)\s*\n}{
        $enumdef .= ($enumdef eq ""?"":",") . $1;
        "";                    # String.
    }eg;
    $enumdef =~ s/\s//g;
    my @vars = split( /,/, $enumdef );
    $enumdef = "";

    $found = 0;
    s{#define\s+(\w+)\s+([\d\.\+\-]+)\s*\n}{
         foreach my $var (@vars) {
            if ($1 eq $var) {
                $enumdef .= ($enumdef eq ""?"":",") . $var . "=" . $2;

                $found++;
                $enummap{$var} = $2;
                last;
            }
         }
         "";
    }eg;

    if ( $found < @vars ) {
        foreach my $var (@vars) {
            unless ( defined( $enummap{$var} ) ) {
                print STDERR "Warning: Constant value for $var was not found.";
            }
        }
    }
    parse_enum( "", $enumdef ) unless ( $enumdef eq "" );

    1 while s{typedef\s+enum
         (\s+\w+)?\s*               # A different name
         \{([\w,\s=-]*)\}\s*        # constants
         (\w+)\s*;                  # typename
    }{
        $typedef{$3} = "enum $3";   # Remember it.
        parse_enum($3, $2);
        '';                         # Just remove the whole statement.
    }xeg;

    1 while s{\s*enum
        (\s+\w+)?\s*                # A different name
        \{([\w,\s=-]*)\}\s*         # constants
    }{
        parse_enum("", $1);
        '';                  # Just remove the whole statement.
    }xeg;

    # Check other typedefs
    s{\btypedef\s+(\w[\w\*\[\]\&\s]*?)\s*\b(\w+)\s*;}{ # Find a typedef.
        $typedef{$2} = canonicalize_type($1, 1);       # Remember it.
        "";
    }eg;

   #
   # Check whether typemap is specified. If so, merge them into a single string.
   #
    my $typemap_str = "";
    s{%typemap\s+(.+)\s*\n}{
        $typemap_str .= ($typemap_str eq ""?"":",") . $1;
        "";                    # String.
    }eg;
    $typemap_str =~ s/\s//g;

    # Obtain list of variables.
    @vars = split( /,/, $typemap_str );

    foreach (@vars) {
        next unless ( $_ ne "" );
        if (/(\w+)=>?(\w+)/) {
            unless ( defined( $builtin_typemap{$2} ) ) {
                die(
"Typemap cannot map to type $2, because it is not a supported MATLAB built-in type.\n"
                      . "The supported types are: %s.\n",
                    join( ", ", @builtin_matlab_types )
                );
            }
            if ( defined( $builtin_typemap{$1} ) ) {
                die("Typemap cannot redefine MATLAB's basic type $1.\n");
            }
            $typemap{$1} = $2;
            push( @typekeys, $1 );
        }
        else {
            die('Typemap string $typemap_str is not formated.\n');
        }
    }
}

#
# Print out type-cast for a particular argument.
#
sub obtain_typecast {
    my ( $expr, $varname ) = @_;
    
    my $mstr;

    $mstr = "\n% Perform dynamic type casting\n";
    if ( defined( $typemap{$expr} ) ) {
        $mstr .= "    $varname = $typemap{$expr}($varname);\n";
    }
    else {
        $mstr .= "datatype = $expr;\n";
        $mstr .= "switch (datatype)\n";
        foreach (@typekeys) {
            $mstr .= "    case $enummap{$_} % $_\n";
            if ( $typemap{$_} eq 'char') {
                $mstr .= "        $varname = [int8($varname), int8(zeros(1,1))];\n";
            } else {
                $mstr .= "        $varname = $typemap{$_}($varname);\n";
            }
        }
        $mstr .= "    otherwise\n";
        $mstr .= "        error('Unknown data type %d', $expr);\n";
        $mstr .= "end\n\n";
    }
    
    $mstr;
}

#
# Print out type-cast for a particular argument.
#
sub obtain_typecast_string {
    my ( $expr, $varname ) = @_;
    
    my $mstr;

    $mstr = "\n% Perform dynamic type casting\n";
    unless ( defined( $typemap{$expr} ) ) {
        foreach (@typekeys) {
            if ( $typemap{$_} eq 'char') {
                $mstr .= "if datatype==$enummap{$_} % $_\n";
                $mstr .= "    $varname = char($varname(1:end-1));\n";
                $mstr .= "end\n";
                last;
            }
        }
    }
    
    $mstr;
}

#TODO: Implement a build-script generator for C.
